LSAmitR (version 1.0-2)

Kapitel 3: Kapitel 3: Standard-Setting

Description

Das ist die Nutzerseite zum Kapitel 3, Standard-Setting, im Herausgeberband Large-Scale Assessment mit R: Methodische Grundlagen der <U+00F6>sterreichischen Bildungsstandard<U+00FC>berpr<U+00FC>fung. Im Abschnitt Details werden die im Kapitel verwendeten R-Syntaxen zur Unterst<U+00FC>tzung f<U+00FC>r Leser/innen kommentiert und dokumentiert. Im Abschnitt Examples werden die R-Syntaxen des Kapitels vollst<U+00E4>ndig wiedergegeben und gegebenenfalls erweitert.

Details

<U+00DC>bersicht <U+00FC>ber die verwendeten Daten

F<U+00FC>r dieses Kapitel werden drei Datens<U+00E4>tze verwendet. Der Datensatz ratings ist das Ergebnis der IDM-Methode, darin enthalten sind f<U+00FC>r alle Items die Einstufung jedes Raters auf eine der drei Kompetenzstufen (1, 2, 3), sowie Item-Nummer und Schwierigkeit. Der Datensatz bookmarks ist das Ergebnis der Bookmark-Methode, darin enthalten sind pro Rater und pro Cut-Score jeweils die gew<U+00E4>hlte Bookmark als Seitenzahl im OIB (die ein bestimmtes Item repr<U+00E4>sentiert). In sdat sind Personenparameter von 3500 Sch<U+00FC>lerinnen und Sch<U+00FC>lern enthalten, diese dienen zur Sch<U+00E4>tzung von Impact Data. Der Datensatz productive ist f<U+00FC>r die Illustration der Contrasting-Groups-Methode gedacht: Dieser enth<U+00E4>lt die Ratings aus der Contrasting-Groups-Methode, pro Rater die Information, ob der entsprechende Text auf die Stufe unter- oder oberhalb des Cut-Scores eingeteilt wurde, sowie Nummer des Textes und Personenf<U+00E4>higkeit.

Abschnitt 3.2.2: Daten aus der IDM-Methode

Listing 1: Feedback

Hier wird der Datensatz ratings verwendet. Er ist das Ergebnis der IDM-Methode, darin enthalten sind f<U+00FC>r alle Items die Einstufung jedes Raters auf eine der drei Kompetenzstufen (1, 2, 3). Zun<U+00E4>chst werden die Rater und die Items aus dem Datensatz ausgew<U+00E4>hlt, dann wird pro Item die prozentuelle Verteilung der Ratings auf die drei Stufen berechnet.

raterID <- grep("R", colnames(ratings), value = TRUE) nraters <- length(raterID) nitems <- nrow(ratings) itemID <- ratings[, 1] itemdiff <- ratings[, 2] stufen <- c(1, 2, 3) # Anzahl der Kompetenzstufen item.freq <- data.frame() # Berechne Prozentuelle Zuteilungen auf Stufen pro Item tabelle.ii <- data.frame() for(ii in 1:nitems){ tabelle.ii <- round(table(factor(as.numeric(ratings[ii, raterID]), levels = stufen)) / nraters * 100, digits = 2) item.freq <- rbind(item.freq, tabelle.ii) } colnames(item.freq) <- paste0("Level_", stufen) item.freq <- data.frame(ratings[, 1:2], item.freq) head(item.freq, 3) # Anmerkung: Item 3 zu 100% auf Stufe 1, Item 2 aufgeteilt # auf Stufe 1 und 2

Listing 1a: Erg<U+00E4>nzung zum Buch

Hier wird eine Grafik erzeugt, in der das Rating-Verhalten sichtbar wird: Pro Item wird angezeigt, wieviele Prozent der Raters es auf eine der drei Stufen eingeteilt haben. Zun<U+00E4>chst werden drei verschiedene Farben definiert, anschlie<U+00DF>end werden drei Barplots erstellt, die zusammen auf einer Seite dargestellt werden. Die Grafik wird zur Orientierung bei Diskussionen verwendet, da so schnell ersichtlich ist, bei welchen Items sich das Experten-Panel einig oder uneinig war. F<U+00FC>r die Grafik gibt es die M<U+00F6>glichkeit, diese in Schwarz-Weiss zu halten oder in Farbe zu gestalten.

# Farben f<U+00FC>r die Grafik definieren - falls eine bunte Grafik gew<U+00FC>nscht ist, # kann barcol <- c(c1, c2, c3) definiert werden c1 <- rgb(239/255, 214/255, 67/255) c2 <- rgb(207/255, 151/255, 49/255) c3 <- rgb(207/255, 109/255, 49/255)

# Aufbereitung Tabelle f<U+00FC>r Grafik freq.dat <- t(as.matrix(item.freq[1:nitems,(3:(2+length(stufen)))])) barcol <- c("black", "gray", "white")

#Grafik wird erzeugt par(mfcol=c(3,1), oma=c(0,0,3,0)) # Angeben der Plot-Anzahl perplot <- round(nitems/3) a <- perplot + 1 b <- perplot*2 c <- b + 1 d <- perplot*3 barplot(freq.dat[,1 : perplot], col = barcol, beside = T, names.arg = seq(1 , perplot), xlab = "Itemnummer (Seitenzahl im OIB)", ylab = "% Zuteilung auf Stufe", horiz = F, ylim = range(1:100)) barplot(freq.dat[, a:b], col = barcol, beside = T, names.arg = seq(a, b), xlab = "Itemnummer (Seitenzahl im OIB)", ylab = "% Zuteilung auf Stufe", horiz = F, ylim = range(1:100)) barplot(freq.dat[, c:d], col = barcol, beside = T, names.arg = seq(c, d), xlab = "Itemnummer (Seitenzahl im OIB)", ylab = "% Zuteilung auf Stufe", horiz = F, ylim = range(1:100)) title("Feedback f<U+00FC>r das Experten-Panel aus der IDM-Methode", outer = T)

Listing 2: Cut-Score Berechnung

Hier wird der Cut-Score aus den Daten der IDM-Methode mithilfe logistischer Regression f<U+00FC>r den ersten Rater im Experten-Panel berechnet. Daf<U+00FC>r wird der zweite Cut-Score herangezogen. Zun<U+00E4>chst m<U+00FC>ssen die entsprechenden Ratings f<U+00FC>r die logistische Regression umkodiert werden (2 = 0, 3 = 1). Anschlie<U+00DF>end wird die logistische Regression berechnet, als unabh<U+00E4>ngige Variable dient die Einstufung durch den jeweiligen Experten (0, 1), als abh<U+00E4>ngige Variable die Itemschwierigkeit. Anhand der erhaltenen Koeffizienten kann der Cut-Score berechnet werden.

library(car) # Rekodieren rate.i <- ratings[which(ratings$R01 %in% c(2, 3)), c("MB_Norm_rp23", "R01")] rate.i$R01 <- recode(rate.i$R01, "2=0; 3=1") coef(cut.i <- glm(rate.i$R01 ~ rate.i$MB_Norm_rp23 , family = binomial(link="logit"))) # Berechnung des Cut-Scores laut Formel cut.R01 <- (-cut.i$coefficients[1])/ cut.i$coefficients[2]

Listing 3: Rater-Analysen

Als ersten Schritt in den Rater-Analysen wird das mittlere Cohen's Kappa eines Raters mit allen anderen Raters berechnet. Daf<U+00FC>r werden zun<U+00E4>chst die Ratings ausgew<U+00E4>hlt und dann f<U+00FC>r jeden Rater die <U+00DC>bereinstimmung mit jedem anderen Rater paarweise berechnet. Anschlie<U+00DF>end werden diese Werte gemittelt und auch die Standard-Abweichung berechnet.

library(irr) # Auswahl der Ratings rater.dat <- ratings[ ,grep("R", colnames(ratings))] # Kappa von jeder Person mit allen anderen Personen wird berechnet kappa.mat <- matrix(NA, nraters, nraters) for(ii in 1:nraters){ rater.eins <- rater.dat[, ii] for(kk in 1:nraters){ rater.zwei <- rater.dat[ ,kk] dfr.ii <- cbind(rater.eins, rater.zwei) kappa.ik <- kappa2(dfr.ii) kappa.mat[ii, kk] <- kappa.ik$value }} diag(kappa.mat) <- NA # Berechne Mittleres Kappa f<U+00FC>r jede Person MW_Kappa <- round(colMeans(kappa.mat, na.rm=T), digits=2) SD_Kappa <- round(apply(kappa.mat, 2, sd, na.rm=T), digits=2) (Kappa.Stat <- data.frame("Person"= raterID, MW_Kappa, SD_Kappa))

Listing 4: Berechnung Fleiss' Kappa

Fleiss' Kappa gibt die <U+00DC>bereinstimmung innerhalb des gesamten Experten-Panels an. Wird das Standard-Setting <U+00FC>ber mehrere Runden durchgef<U+00FC>hrt, kann Fleiss' Kappa auch f<U+00FC>r jede Runde berechnet werden.

kappam.fleiss(rater.dat)

Listing 5: Modalwerte

Auch die Korrelation zwischen dem Modalwert jedes Items (d.h., ob es am h<U+00E4>ufigsten auf Stufe 1, 2 oder 3 eingeteilt wurde) und der inviduellen Zuordnung durch einen Rater kann zu Rater-Analysen herangezogen werden. Zun<U+00E4>chst wird der Modal-Wert eines jeden Items berechnet. Hat ein Item zwei gleich h<U+00E4>ufige Werte, gibt es eine Warnmeldung und es wird f<U+00FC>r dieses Item NA anstatt eines Wertes vergeben (f<U+00FC>r diese Analyse sind aber nur Items von Interesse, die einen eindeutigen Modalwert haben). Danach wird pro Rater die Korrelation zwischen dem Modalwert eines Items und der entsprechenden Einteilung durch den Rater berechnet, und dann in aufsteigender H<U+00F6>he ausgegeben.

library(prettyR) # Berechne Modalwert mode <- as.numeric(apply(rater.dat, 1, Mode)) # Korrelation f<U+00FC>r die Ratings jeder Person im Panel mit den # Modalwerten der Items corr <- data.frame() for(z in raterID){ rater.ii <- rater.dat[, (grep(z, colnames(rater.dat)))] cor.ii <- round(cor(mode, rater.ii, use = "pairwise.complete.obs", method = "spearman"), digits = 2) corr <- rbind(corr, cor.ii) } corr[, 2] <- raterID colnames(corr) <- c("Korrelation", "Rater") # Aufsteigende Reihenfolge (corr <- corr[order(corr[, 1]),])

Listing 5a: Erg<U+00E4>nzung zum Buch

Die Korrelation zwischen Modalwerten und individueller Zuordnung kann auch zur besseren <U+00DC>bersicht graphisch gezeigt werden. Dabei werden die Korrelationen der Raters aufsteigend dargestellt.

# Grafik plot(corr$Korrelation, xlab = NA, ylab = "Korrelation", ylim = c(0.5, 1), xaxt = "n", main = "Korrelation zwischen Modalwert und individueller Zuordnung der Items pro Rater/in") text(seq(1:nraters), corr$Korrelation - 0.02, labels = corr[, 2], offset = 1, cex = 1) title(xlab = "Raters nach aufsteigender Korrelation gereiht")

Listing 6: ICC

Hier wird der ICC als Ausdruck der <U+00DC>bereinstimmung (d.h., Items werden auf dieselbe Stufe eingeteilt) und der Konsistenz (d.h., Items werden in dieselbe Reihenfolge gebracht) zwischen Raters berechnet. Falls es mehrere Runden gibt, kann der ICC auch wiederholt berechnet und verglichen werden.

library(irr) (iccdat.agree <- icc(rater.dat, model = "twoway", type = "agreement", unit = "single", r0 = 0, conf.level=0.95)) (iccdat.cons <- icc(rater.dat, model = "twoway", type = "consistency", unit = "single", r0 = 0, conf.level=0.95))

Abschnitt 3.2.3: Daten aus der Bookmark-Methode

Listing 1: Feedback

Auch in der Bookmark-Methode wird dem Experten-Panel Feedback angeboten, um die Diskussion zu f<U+00F6>rdern. Hier wird pro Cut-Score Median, Mittelwert und Standard-Abweichung der Bookmarks (Seitenzahl im OIB) im Experten-Panel berechnet.

head(bookmarks) statbookm <- data.frame("Stats"=c("Md","Mean","SD"), "Cut1"=0, "Cut2"=0) statbookm[1,2] <- round(median(bookmarks$Cut1), digits=2) statbookm[1,3] <- round(median(bookmarks$Cut2), digits=2) statbookm[2,2] <- round(mean(bookmarks$Cut1), digits=2) statbookm[2,3] <- round(mean(bookmarks$Cut2), digits=2) statbookm[3,2] <- round(sd(bookmarks$Cut1), digits=2) statbookm[3,3] <- round(sd(bookmarks$Cut2), digits=2) (statbookm) table(bookmarks$Cut1) table(bookmarks$Cut2)

Listing 2: Cut-Score Berechnung

Jede Bookmark repr<U+00E4>sentiert ein Item, das eine bestimmte Itemschwierigkeit hat. Die Cut-Scores lassen sich berechnen, in dem man die unterliegenden Itemschwierigkeiten der Bookmarks mittelt.

bm.cut <- NULL bm.cut$cut1 <- mean(ratings$MB_Norm_rp23[bookmarks$Cut1]) bm.cut$cut2 <- mean(ratings$MB_Norm_rp23[bookmarks$Cut2]) bm.cut$cut1sd <- sd(ratings$MB_Norm_rp23[bookmarks$Cut1]) bm.cut$cut2sd <- sd(ratings$MB_Norm_rp23[bookmarks$Cut2])

Listing 3: Standardfehler des Cut-Scores

Der Standardfehler wird berechnet, um eine m<U+00F6>gliche Streuung des Cut-Scores zu berichten.

se.cut1 <- bm.cut$cut1sd/sqrt(nraters) se.cut2 <- bm.cut$cut2sd/sqrt(nraters)

Listing 4: Impact Data

Mithilfe von Impact Data wird auf Basis von pilotierten Daten gesch<U+00E4>tzt, welche Auswirkungen die Cut-Scores auf die Sch<U+00FC>lerpopulation h<U+00E4>tten (d.h., wie sich die Sch<U+00FC>lerinnen und Sch<U+00FC>ler auf die Stufen verteilen w<U+00FC>rden). F<U+00FC>r diese Sch<U+00E4>tzung werden die Personenparameter herangezogen. Anschlie<U+00DF>end wird die Verteilung der Personenparameter entsprechend der Cut-Scores unterteilt. Die Prozentangaben der Sch<U+00FC>lerinnen und Sch<U+00FC>ler, die eine bestimmte Stufe erreichen, dienen dem Experten-Panel als Diskussionsgrundlage.

Pers.Para <- sdat[, "TPV1"] cuts <- c(bm.cut$cut1, bm.cut$cut2) # Definiere Bereiche: Minimaler Personenparameter bis Cut-Score 1, # Cut-Score 1 bis Cut-Score 2, Cut-Score 2 bis maximaler # Personenparameter Cuts.Vec <- c(min(Pers.Para)-1, cuts, max(Pers.Para)+1) # Teile Personenparameter in entsprechende Bereiche auf Kum.Cuts <- cut(Pers.Para, breaks = Cuts.Vec) # Verteilung auf die einzelnen Bereiche Freq.Pers.Para <- xtabs(~ Kum.Cuts) nstud <- nrow(sdat) # Prozent-Berechnung prozent <- round(as.numeric(Freq.Pers.Para / nstud * 100), digits = 2) (Impact.Data <- data.frame("Stufe" = c("A1", "A2", "B1"), "Prozent" = prozent))

Abschnitt 3.3.3: Daten aus der Contrasting-Groups-Methode

Listing 1: Cut-Scores

Hier wird der Cut-Score f<U+00FC>r den produktiven Bereich Schreiben berechnet, die Basis ist dabei die Personenf<U+00E4>higkeeit. Dabei wird pro Rater vorgegangen. F<U+00FC>r jeden Rater werden dabei zwei Gruppen gebildet - Texte, die auf die untere Stufe eingeteilt wurden und Texte, die auf die obere Stufe eingeteilt wurden. Von beiden Gruppen wird jeweils der Mittelwert der Personenf<U+00E4>higkeit berechnet und anschlie<U+00DF>end der Mittelwert zwischen diesen beiden Gruppen. Wurde das f<U+00FC>r alle Raters durchgef<U+00FC>hrt, k<U+00F6>nnen die individuell gesetzten Cut-Scores wiederum gemittelt werden und die Standard-Abweichung sowie der Standardfehler berechnet werden.

raterID <- grep("R", colnames(productive), value = TRUE) nraters <- length(raterID) nscripts <- nrow(productive) # Berechne Cut-Score f<U+00FC>r jeden Rater cutscore <- data.frame("rater"=raterID, "cut1.ges"=NA) for(ii in 1:length(raterID)){ rater <- raterID[ii] rates.ii <- productive[ ,grep(rater, colnames(productive))] mean0.ii <- mean(productive$Performance[rates.ii == 0], na.rm = T) mean1.ii <- mean(productive$Performance[rates.ii == 1], na.rm = T) mean.ii <- mean(c(mean1.ii, mean0.ii), na.rm = T) cutscore[ii, "cut1.ges"] <- mean.ii } # Finaler Cut-Score cut1 <- mean(cutscore$cut1.ges) sd.cut1 <- sd(cutscore$cut1.ges) se.cut1 <- sd.cut1/sqrt(nraters)

Appendix: Abbildungen im Buch

Hier ist der R-Code f<U+00FC>r die im Buch abgedruckten Grafiken zu finden.

Abbildung 3.1

In einem n<U+00E4>chsten Schritt wird anhand des mittleren Kappa und der dazugeh<U+00F6>rigen Standard-Abweichung eine Grafik erstellt, um die <U+00DC>bereinstimmung eines Raters mit allen anderen Ratern dazustellen. Daf<U+00FC>r wird zun<U+00E4>chst ein Boxplot des mittleren Kappa pro Rater erzeugt. In einem zweiten Schritt werden die mittleren Kappas mit der dazugeh<U+00F6>rigen Standard-Abweichung abgetragen. Linien markieren 1.5 Standard-Abweichungen vom Mittelwert. Raters, die <U+00FC>ber oder unter dieser Grenze liegen, werden gekennzeichnet.

# GRAFIK # 1. Grafik par(fig=c(0, 1, 0, 0.35), oma=c(0,0,3,0), cex = 0.85) boxplot(Kappa.Stat$MW_Kappa, horizontal = T, ylim=c(0.42,0.66), axes = F, xlab = "MW Kappa") # 2. Grafik wird hinzugef<U+00FC>gt par(fig=c(0, 1, 0.2, 1), new=TRUE) sd.factor <- 1.5 mmw <- mean(Kappa.Stat$MW_Kappa) sdmw <- sd(Kappa.Stat$MW_Kappa) #Grenzwerte f<U+00FC>r MW und SD werden festgelegt mwind <- c(mmw-(sd.factor*sdmw), mmw+(sd.factor*sdmw)) plot(Kappa.Stat$MW_Kappa, Kappa.Stat$SD_Kappa, xlab = "", ylab = "SD Kappa", type = "n", xlim = c(0.42, 0.66), ylim = c(0, 0.2)) abline(v = mwind, col="grey", lty = 2) # Rater mit 1.5 SD Abweichung vom MW werden grau markiert abw.rater <- which(Kappa.Stat$MW_Kappa < mwind[1] | Kappa.Stat$MW_Kappa > mwind[2]) points(Kappa.Stat$MW_Kappa[-abw.rater], Kappa.Stat$SD_Kappa[-abw.rater], pch = 19) points(Kappa.Stat$MW_Kappa[abw.rater], Kappa.Stat$SD_Kappa[abw.rater], pch = 25, bg = "grey") text(Kappa.Stat$MW_Kappa[abw.rater], Kappa.Stat$SD_Kappa[abw.rater], Kappa.Stat$Person[abw.rater], pos = 3) title("Rater-Analysen: MW und SD Kappa aus der IDM-Methode", outer = TRUE)

Abbildung 3.2

Um das Feedback <U+00FC>ber die Setzung der Bookmarks an das Experten-Panel einfacher zu gestalten, wird eine Grafik erstellt. Darin sieht man pro Cut-Score, wo die Raters ihre Bookmarks (d.h. Seitenzahl im OIB) gesetzt haben, sowie Info <U+00FC>ber den Mittelwert dieser Bookmarks. Diese Grafik soll die Diskussion f<U+00F6>rdern.

nitems <- 60

library(lattice) library(gridExtra) #Erster Plot mit Mittelwert plot.Cut1 <- dotplot(bookmarks$Rater ~ bookmarks$Cut1, col = "black", panel = function(...){ panel.dotplot(...) panel.abline(v = mean(bookmarks$Cut1), lty = 5) }, xlab = "Bookmarks f<U+00FC>r Cut-Score 1 (Seite im OIB)", ylab = "Raters", cex = 1.3) #Zweiter Plot mit Mittelwert plot.Cut2 <- dotplot(bookmarks$Rater ~ bookmarks$Cut2, col = "black", panel = function(...){ panel.dotplot(...) panel.abline(v = mean(bookmarks$Cut2), lty = 5) }, xlab = "Bookmarks f<U+00FC>r Cut-Score 2 (Seite im OIB)", ylab = "Raters", cex = 1.3) #Plots nebeneinander anordnen grid.arrange(plot.Cut1, plot.Cut2, nrow = 1, top = "Bookmarks pro Rater/in")

References

Luger-Bazinger, C., Freunberger, R. & Itzlinger-Bruneforth, U. (2016). Standard-Setting. In S. Breit & C. Schreiner (Hrsg.), Large-Scale Assessment mit R: Methodische Grundlagen der <U+00F6>sterreichischen Bildungsstandard<U+00FC>berpr<U+00FC>fung (pp. 83--110). Wien: facultas.

See Also

Zu datenKapitel03, den im Kapitel verwendeten Daten. Zur<U+00FC>ck zu Kapitel 2, Stichprobenziehung. Zu Kapitel 4, Differenzielles Itemfunktionieren in Subgruppen. Zur <U+00DC>bersicht.

Examples

# NOT RUN {
library(car)
library(irr)
library(prettyR)
library(lattice)
library(gridExtra)

data(datenKapitel03)
ratings <- datenKapitel03$ratings
bookmarks <- datenKapitel03$bookmarks
sdat <- datenKapitel03$sdat
productive <- datenKapitel03$productive

# }
# NOT RUN {
## -------------------------------------------------------------
## Abschnitt 3.2.2: Daten aus der IDM-Methode
## -------------------------------------------------------------

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 1: Feedback
#

raterID <- grep("R", colnames(ratings), value = TRUE)
nraters <- length(raterID) 
nitems <- nrow(ratings) 
itemID <- ratings[, 1] 
itemdiff <- ratings[, 2]
stufen <- c(1, 2, 3) # Anzahl der Kompetenzstufen
item.freq <- data.frame() 
# Berechne Prozentuelle Zuteilungen auf Stufen pro Item
tabelle.ii <- data.frame()
for(ii in 1:nitems){   
  tabelle.ii <- round(table(factor(as.numeric(ratings[ii, 
    raterID]), levels = stufen)) / nraters * 100, digits = 2)      
  item.freq <- rbind(item.freq, tabelle.ii) }
colnames(item.freq) <- paste0("Level_", stufen)
item.freq <- data.frame(ratings[, 1:2], item.freq)
head(item.freq, 3)
# Anmerkung: Item 3 zu 100% auf Stufe 1, Item 2 aufgeteilt 
# auf Stufe 1 und 2

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 1a: Erg<U+00E4>nzung zum Buch
# GRAFIK-Erzeugung
#

# Farben f<U+00FC>r die Grafik definieren
c1 <- rgb(239/255, 214/255, 67/255)  
c2 <- rgb(207/255, 151/255, 49/255)  
c3 <- rgb(207/255, 109/255, 49/255)

# Aufbereitung Tabelle f<U+00FC>r Grafik
freq.dat <- t(as.matrix(item.freq[1:nitems,(3:(2+length(stufen)))]))
barcol <- c("black", "gray", "white") 

#Grafik wird erzeugt
par(mfcol=c(3,1), oma=c(0,0,3,0)) # Angeben der Plot-Anzahl      
perplot <- round(nitems/3)    
a <- perplot + 1   
b <- perplot*2  
c <- b + 1     
d <- perplot*3
barplot(freq.dat[,1 : perplot], col = barcol, beside = T, 
        names.arg = seq(1 , perplot), xlab = "Itemnummer (Seitenzahl im OIB)", 
        ylab = "% Zuteilung auf Stufe", horiz = F, ylim = range(1:100))
barplot(freq.dat[, a:b], col = barcol, beside = T, names.arg = seq(a, b), 
        xlab = "Itemnummer (Seitenzahl im OIB)", 
        ylab = "% Zuteilung auf Stufe", 
        horiz = F, ylim = range(1:100))
barplot(freq.dat[, c:d], col = barcol, beside = T, names.arg = seq(c, d), 
        xlab = "Itemnummer (Seitenzahl im OIB)", 
        ylab = "% Zuteilung auf Stufe", 
        horiz = F, ylim = range(1:100))
title("Feedback f<U+00FC>r das Experten-Panel aus der IDM-Methode", outer = T)

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 2: Cut-Score Berechnung
#

library(car)
# Rekodieren
rate.i <- ratings[which(ratings$R01 %in% c(2, 3)), 
                  c("Norm_rp23", "R01")] 
rate.i$R01 <-  recode(rate.i$R01, "2=0; 3=1")
coef(cut.i <- glm(rate.i$R01  ~ rate.i$Norm_rp23 , 
                  family = binomial(link="logit")))
# Berechnung des Cut-Scores laut Formel
cut.R01 <- (-cut.i$coefficients[1])/ cut.i$coefficients[2]

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 3: Rater-Analysen
# 

library(irr)
# Auswahl der Ratings
rater.dat <- ratings[ ,grep("R", colnames(ratings))]
# Berechne Kappa von jeder Person mit allen anderen Personen
kappa.mat <- matrix(NA, nraters, nraters) 
for(ii in 1:nraters){  
  rater.eins <- rater.dat[, ii]      
  for(kk in 1:nraters){    
    rater.zwei <- rater.dat[ ,kk]
    dfr.ii <- cbind(rater.eins, rater.zwei)
    kappa.ik <- kappa2(dfr.ii)       
    kappa.mat[ii, kk] <- kappa.ik$value }} 
diag(kappa.mat) <- NA 
# Berechne Mittleres Kappa f<U+00FC>r jede Person
MW_Kappa <- round(colMeans(kappa.mat, na.rm=T), digits=2) 
SD_Kappa <- round(apply(kappa.mat, 2, sd, na.rm=T), digits=2) 
(Kappa.Stat <- data.frame("Person"= raterID, MW_Kappa, 
  SD_Kappa))

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 4: Berechnung Fleiss' Kappa
# 

kappam.fleiss(rater.dat)

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 5: Modalwerte
# 

library(prettyR)
# Berechne Modalwert
mode <- as.numeric(apply(rater.dat, 1, Mode))
# Korrelation f<U+00FC>r die Ratings jeder Person im Panel mit den 
# Modalwerten der Items
corr <- data.frame()
for(z in raterID){
  rater.ii <- rater.dat[, (grep(z, colnames(rater.dat)))]
  cor.ii <- round(cor(mode, rater.ii, method = "spearman",
    use = "pairwise.complete.obs"), digits = 2)
  corr <- rbind(corr, cor.ii)
}
corr[, 2] <- raterID
colnames(corr) <- c("Korrelation", "Rater")
# Aufsteigende Reihenfolge 
(corr <- corr[order(corr[, 1]),])

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 5: Erg<U+00E4>nzung zum Buch
# GRAFIK-Erzeugung und ICC
#

# Grafik
plot(corr$Korrelation, xlab = NA, ylab = "Korrelation",   
     ylim = c(0.5, 1), xaxt = "n", main = "Korrelation zwischen 
     Modalwert und individueller Zuordnung der Items pro Rater/in")
text(seq(1:nraters), corr$Korrelation - 0.02, labels = corr[, 2], 
     offset = 1, cex = 1)
title(xlab = "Raters nach aufsteigender Korrelation gereiht")

# -------------------------------------------------------------
# Abschnitt 3.2.2, Listing 6: ICC
# 

library(irr)
(iccdat.agree <- icc(rater.dat, model = "twoway", 
  type = "agreement", unit = "single", r0 = 0, conf.level=0.95))
(iccdat.cons <- icc(rater.dat, model = "twoway", 
  type = "consistency", unit = "single", r0 = 0, conf.level=0.95))


## -------------------------------------------------------------
## Abschnitt 3.2.3: Daten aus der Bookmark-Methode
## -------------------------------------------------------------

# -------------------------------------------------------------
# Abschnitt 3.2.3, Listing 1: Feedback
# 

head(bookmarks)
statbookm <- data.frame("Stats"=c("Md","Mean","SD"), 
                        "Cut1"=0, "Cut2"=0)
statbookm[1,2] <- round(median(bookmarks$Cut1), digits=2)
statbookm[1,3] <- round(median(bookmarks$Cut2), digits=2)
statbookm[2,2] <- round(mean(bookmarks$Cut1), digits=2)
statbookm[2,3] <- round(mean(bookmarks$Cut2), digits=2)
statbookm[3,2] <- round(sd(bookmarks$Cut1), digits=2)
statbookm[3,3] <- round(sd(bookmarks$Cut2), digits=2)
(statbookm)
table(bookmarks$Cut1)
table(bookmarks$Cut2)

# -------------------------------------------------------------
# Abschnitt 3.2.3, Listing 2: Cut-Score Berechnung
# 

bm.cut <- NULL 
bm.cut$cut1 <- mean(ratings$Norm_rp23[bookmarks$Cut1]) 
bm.cut$cut2 <- mean(ratings$Norm_rp23[bookmarks$Cut2]) 
bm.cut$cut1sd <- sd(ratings$Norm_rp23[bookmarks$Cut1]) 
bm.cut$cut2sd <- sd(ratings$Norm_rp23[bookmarks$Cut2]) 

# -------------------------------------------------------------
# Abschnitt 3.2.3, Listing 3: Standardfehler des Cut-Scores
# 

se.cut1 <- bm.cut$cut1sd/sqrt(nraters)
se.cut2 <- bm.cut$cut2sd/sqrt(nraters)

# -------------------------------------------------------------
# Abschnitt 3.2.3, Listing 4: Impact Data
#

Pers.Para <- sdat[, "TPV1"]
cuts <- c(bm.cut$cut1, bm.cut$cut2)
# Definiere Bereiche: Minimaler Personenparameter bis Cut-Score 1, 
#   Cut-Score 1 bis Cut-Score 2, Cut-Score 2 bis maximaler 
#   Personenparameter
Cuts.Vec <- c(min(Pers.Para)-1, cuts, max(Pers.Para)+1)
# Teile Personenparameter in entsprechende Bereiche auf
Kum.Cuts <- cut(Pers.Para, breaks = Cuts.Vec)
# Verteilung auf die einzelnen Bereiche
Freq.Pers.Para <- xtabs(~ Kum.Cuts)
nstud <- nrow(sdat)
# Prozent-Berechnung
prozent <- round(as.numeric(Freq.Pers.Para / nstud * 100), 
                 digits = 2) 
(Impact.Data <- data.frame("Stufe" = c("A1", "A2", "B1"), 
                           "Prozent" = prozent))


## -------------------------------------------------------------
## Abschnitt 3.3.2: Daten aus der Contrasting-Groups-Methode
## -------------------------------------------------------------

# -------------------------------------------------------------
# Abschnitt 3.3.2, Listing 1: Cut-Scores
#

raterID <- grep("R", colnames(productive), value = TRUE) 
nraters <- length(raterID)  
nscripts <- nrow(productive) 
# Berechne Cut-Score f<U+00FC>r jeden Rater
cutscore <- data.frame("rater"=raterID, "cut1.ges"=NA)
for(ii in 1:length(raterID)){ 
  rater <- raterID[ii]   
  rates.ii <- productive[ ,grep(rater, colnames(productive))]   
  mean0.ii <- mean(productive$Performance[rates.ii == 0], 
    na.rm = TRUE)   
  mean1.ii <- mean(productive$Performance[rates.ii == 1], 
    na.rm = TRUE)   
  mean.ii <- mean(c(mean1.ii, mean0.ii), na.rm = TRUE)   
  cutscore[ii, "cut1.ges"] <- mean.ii }
# Finaler Cut-Score
cut1 <- mean(cutscore$cut1.ges)
sd.cut1 <- sd(cutscore$cut1.ges)
se.cut1 <- sd.cut1/sqrt(nraters)


## -------------------------------------------------------------
## Appendix: Abbildungen
## -------------------------------------------------------------

# -------------------------------------------------------------
# Abbildung 3.1
#

# 1. Grafik
par(fig=c(0, 1, 0, 0.35), oma=c(0,0,3,0), cex = 0.85) 
boxplot(Kappa.Stat$MW_Kappa, horizontal = T, ylim=c(0.42,0.66), 
        axes = F, xlab = "MW Kappa")
# 2. Grafik wird hinzugef<U+00FC>gt
par(fig=c(0, 1, 0.2, 1), new=TRUE)
sd.factor <- 1.5 
mmw <- mean(Kappa.Stat$MW_Kappa)
sdmw <- sd(Kappa.Stat$MW_Kappa)
#Grenzwerte f<U+00FC>r MW und SD werden festgelegt
mwind <- c(mmw-(sd.factor*sdmw), mmw+(sd.factor*sdmw))
plot(Kappa.Stat$MW_Kappa, Kappa.Stat$SD_Kappa, xlab = "",
     ylab = "SD Kappa", type = "n", xlim = c(0.42, 0.66), 
     ylim = c(0, 0.2))
abline(v = mwind, col="grey", lty = 2)
# Rater mit 1.5 SD Abweichung vom MW werden grau markiert 
abw.rater <- which(Kappa.Stat$MW_Kappa < mwind[1] | 
                     Kappa.Stat$MW_Kappa > mwind[2])
points(Kappa.Stat$MW_Kappa[-abw.rater], 
       Kappa.Stat$SD_Kappa[-abw.rater], 
       pch = 19)
points(Kappa.Stat$MW_Kappa[abw.rater], 
       Kappa.Stat$SD_Kappa[abw.rater], 
       pch = 25, bg = "grey")
text(Kappa.Stat$MW_Kappa[abw.rater], 
     Kappa.Stat$SD_Kappa[abw.rater], 
     Kappa.Stat$Person[abw.rater], 
     pos = 3) 
title("Rater-Analysen: MW und SD Kappa aus der IDM-Methode", 
      outer = TRUE)

# -------------------------------------------------------------
# Abbildung 3.2
#

nitems <- 60

library(lattice)
library(gridExtra)
#Erster Plot mit Mittelwert
plot.Cut1 <- dotplot(bookmarks$Rater ~ bookmarks$Cut1, col = "black", 
                     panel = function(...){
                       panel.dotplot(...)
                       panel.abline(v = mean(bookmarks$Cut1), lty = 5)
                     }, 
                     xlab = "Bookmarks f<U+00FC>r Cut-Score 1 (Seite im OIB)",
                     ylab = "Raters", cex = 1.3)
#Zweiter Plot mit Mittelwert
plot.Cut2 <- dotplot(bookmarks$Rater ~ bookmarks$Cut2, col = "black", 
                     panel = function(...){
                       panel.dotplot(...)
                       panel.abline(v = mean(bookmarks$Cut2), lty = 5)
                     }, 
                     xlab = "Bookmarks f<U+00FC>r Cut-Score 2 (Seite im OIB)", 
                     ylab = "Raters", cex = 1.3)
#Plots nebeneinander anordnen
grid.arrange(plot.Cut1, plot.Cut2, nrow = 1, top = "Bookmarks pro Rater/in")

# }